home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / winFont.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  6.1 KB  |  178 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out the procedures in tkWinFont.c. 
  2. # It is organized in the standard fashion for Tcl tests.
  3. #
  4. # Many of these tests are visually oriented and cannot be checked
  5. # programmatically (such as "does an underlined font appear to be
  6. # underlined?"); these tests attempt to exercise the code in question,
  7. # but there are no results that can be checked.  
  8. #
  9. # Copyright (c) 1996-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14. # SCCS: @(#) winFont.test 1.7 97/04/25 16:55:00
  15.  
  16. if {$tcl_platform(platform)!="windows"} {
  17.     return
  18. }
  19.  
  20. if {[string compare test [info procs test]] != 0} {
  21.     source defs
  22. }
  23.  
  24. catch {destroy .b}
  25. catch {font delete xyz}
  26.  
  27. toplevel .b
  28. update idletasks
  29.  
  30. set courier {Courier 14}
  31. set cx [font measure $courier 0]
  32.  
  33. label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed
  34. pack .b.l
  35. canvas .b.c -closeenough 0
  36.  
  37. set t [.b.c create text 0 0 -anchor nw -just left -font $courier]
  38. pack .b.c
  39. update
  40.  
  41. set ax [winfo reqwidth .b.l]
  42. set ay [winfo reqheight .b.l]
  43. proc getsize {} {
  44.     update
  45.     return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
  46. }
  47.  
  48. test winfont-1.1 {TkpGetNativeFont procedure: not native} {
  49.     list [catch {font measure {} xyz} msg] $msg
  50. } {1 {font "" doesn't exist}}
  51. test winfont-1.2 {TkpGetNativeFont procedure: native} {
  52.     font measure ansifixed 0
  53.     font measure ansi 0
  54.     font measure device 0
  55.     font measure oemfixed 0
  56.     font measure systemfixed 0
  57.     font measure system 0
  58.     set x {}
  59. } {}
  60.  
  61. test winfont-2.1 {TkpGetFontFromAttributes procedure: pointsize} {
  62.     expr [font actual {-size -10} -size]>0
  63. } {1}
  64. test winfont-2.2 {TkpGetFontFromAttributes procedure: pointsize} {
  65.     expr [font actual {-family Arial} -size]>0
  66. } {1}
  67. test winfont-2.3 {TkpGetFontFromAttributes procedure: normal weight} {
  68.     font actual {-weight normal} -weight
  69. } {normal}
  70. test winfont-2.4 {TkpGetFontFromAttributes procedure: bold weight} {
  71.     font actual {-weight bold} -weight
  72. } {bold}
  73. test winfont-2.5 {TkpGetFontFromAttributes procedure: no family} {
  74.     catch {expr {[font actual {-size 10} -size]}}
  75. } 0
  76. test winfont-2.6 {TkpGetFontFromAttributes procedure: family} {
  77.     font actual {-family Arial} -family
  78. } {Arial}
  79. test winfont-2.7 {TkpGetFontFromAttributes procedure: Times fonts} {
  80.     set x {}
  81.     lappend x [font actual {-family "Times"} -family]
  82.     lappend x [font actual {-family "New York"} -family]
  83.     lappend x [font actual {-family "Times New Roman"} -family]
  84. } {{Times New Roman} {Times New Roman} {Times New Roman}}
  85. test winfont-2.8 {TkpGetFontFromAttributes procedure: Courier fonts} {
  86.     set x {}
  87.     lappend x [font actual {-family "Courier"} -family]
  88.     lappend x [font actual {-family "Monaco"} -family]
  89.     lappend x [font actual {-family "Courier New"} -family]
  90. } {{Courier New} {Courier New} {Courier New}}
  91. test winfont-2.9 {TkpGetFontFromAttributes procedure: Helvetica fonts} {
  92.     set x {}
  93.     lappend x [font actual {-family "Helvetica"} -family]
  94.     lappend x [font actual {-family "Geneva"} -family]
  95.     lappend x [font actual {-family "Arial"} -family]
  96. } {Arial Arial Arial}
  97. test winfont-2.10 {TkpGetFontFromAttributes procedure: fallback} {
  98.     # No way to get it to fail! Any font name is acceptable.
  99. } {}
  100.  
  101. test winfont-3.1 {TkpDeleteFont procedure} {
  102.     font actual {-family xyz}
  103.     set x {}
  104. } {}
  105.  
  106. test winfont-4.1 {TkpGetFontFamilies procedure} {
  107.     font families
  108.     set x {}
  109. } {}
  110.  
  111. test winfont-5.1 {Tk_MeasureChars procedure: unbounded right margin} {
  112.     .b.l config -wrap 0 -text "000000"
  113.     getsize
  114. } "[expr $ax*6] $ay"
  115. test winfont-5.2 {Tk_MeasureChars procedure: static width buffer exceeded} {
  116.     .b.l config -wrap 100000 -text "0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"
  117.     getsize
  118. } "[expr $ax*256] $ay"
  119. test winfont-5.3 {Tk_MeasureChars procedure: all chars did fit} {
  120.     .b.l config -wrap [expr $ax*10] -text "00000000"
  121.     getsize
  122. } "[expr $ax*8] $ay"
  123. test winfont-5.4 {Tk_MeasureChars procedure: not all chars fit} {
  124.     .b.l config -wrap [expr $ax*6] -text "00000000"
  125.     getsize
  126. } "[expr $ax*6] [expr $ay*2]"
  127. test winfont-5.5 {Tk_MeasureChars procedure: include last partial char} {
  128.     .b.c dchars $t 0 end
  129.     .b.c insert $t 0 "0000"
  130.     .b.c index $t @[expr int($cx*2.5)],1
  131. } {2}
  132. test winfont-5.6 {Tk_MeasureChars procedure: at least one char on line} { 
  133.     .b.l config -text "000000" -wrap 1
  134.     getsize
  135. } "$ax [expr $ay*6]"
  136. test winfont-5.7 {Tk_MeasureChars procedure: whole words} {
  137.     .b.l config -wrap [expr $ax*8] -text "000000 0000"
  138.     getsize
  139. } "[expr $ax*6] [expr $ay*2]"
  140. test winfont-5.8 {Tk_MeasureChars procedure: already saw space in line} {
  141.     .b.l config -wrap [expr $ax*12] -text "000000    0000000"
  142.     getsize
  143. } "[expr $ax*7] [expr $ay*2]"
  144. test winfont-5.9 {Tk_MeasureChars procedure: internal spaces significant} {
  145.     .b.l config -wrap [expr $ax*12] -text "000  00   00000"
  146.     getsize
  147. } "[expr $ax*7] [expr $ay*2]"
  148. test winfont-5.10 {Tk_MeasureChars procedure: make first part of word fit} {
  149.     .b.l config -wrap [expr $ax*12] -text "0000000000000000"
  150.     getsize
  151. } "[expr $ax*12] [expr $ay*2]"
  152.  
  153. test winfont-6.1 {Tk_DrawChars procedure: loop test} {
  154.     .b.l config -text "a"
  155.     update
  156. } {}
  157.  
  158. test winfont-7.1 {AllocFont procedure: use old font} {
  159.     font create xyz
  160.     catch {destroy .c}
  161.     button .c -font xyz
  162.     font configure xyz -family times
  163.     update
  164.     destroy .c
  165.     font delete xyz
  166. } {}
  167. test winfont-7.2 {AllocFont procedure: extract info from logfont} {
  168.     font actual {arial 10 bold italic underline overstrike}
  169. } {-family Arial -size 10 -weight bold -slant italic -underline 1 -overstrike 1}
  170. test winfont-7.3 {AllocFont procedure: extract info from textmetric} {
  171.     font metric {arial 10 bold italic underline overstrike} -fixed
  172. } {0}
  173. test winfont-7.4 {AllocFont procedure: extract info from textmetric} {
  174.     font metric systemfixed -fixed
  175. } {1}
  176.  
  177. destroy .b
  178.